Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Snippets/3D-Maze 1.0/3D-Maze.p

Text File | 1995-08-06 | 17.2 KB | 681 lines | [TEXT/PJMM]

{• 3-D-Maze.p}

{• Updated and simplified by Kenneth A. Long at itty bitty bytes™.}
{Nicely simplified, too - easy to convert to Pascal! Which, of course, made it even simpler!}

program ThreeDMaze;

{$ifc UNDEFINED THINK_PASCAL}
    uses
        Types, QuickDraw, Events, Windows, Dialogs, Fonts, Traps,{}
        Memory, SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, Devices, DiskInit;
{$elsec}
{Some new routine names for Think Pascal}
    procedure AppendResMenu (theMenu: MenuHandle; theType: ResType);
    inline
        $A94D;
    procedure GetMenuItemText (theMenu: MenuHandle; item: INTEGER; var itemString: Str255);
    inline
        $A946;
{$endc}


    const
        I_OK = 1;
        I_x = 2;
        I_x3 = 3;
        I_x5 = 4;
        I_Rectangle1 = 5;

    type
        view = record
                rows: array[0..5, 0..4] of Boolean;
            end;

    type
        viewpoint = record
                x, y: Integer;
                facing: Byte;
            end;
    var
        gridBytes: Integer;
        mazeImageAdd: array[0..7] of Ptr;
        mazeRect: Rect;
        mazeImage: array[0..7] of BitMap;
        yourView: viewpoint;
        youSee: view;
        viewRects: array[0..15] of Rect;

        gScreenBitsBounds: Rect;    {To avoid all $IFC's}

{Important change: "maze" and "rectValues" are now in resources.}
{IMHO, the "rectValues" would be better off calculated, in order to make the program}
{easier to modify, but having the maze in a resource makes lots of sense!}

    type
        MazeArr = array[0..15, 0..15] of Boolean;
        MazeArrPtr = ^MazeArr;
        MazeArrHnd = ^MazeArrPtr;
    var
        maze: MazeArrHnd;

    type
        RectArr = array[0..29] of Integer;
        RectArrPtr = ^RectArr;
        RectArrHnd = ^RectArrPtr;
    var
        rectValues: RectArrHnd;

        myWindow: WindowPtr;
        tempRect, temp2Rect: Rect;
        index: Integer;
        CtrlHandle: ControlHandle;
        sTemp: Str255;
        MyErr: OSErr;

        AppleMenu: MenuHandle;

        ExitDialog: Boolean;
        DoubleClick: char;
        myPt: Point;


    procedure D_About;
    begin
        if Alert(2, nil) = 1 then
            ;
    end; {D_About}


    procedure DrawMaze;
        var
            i: Integer;
    begin
        CopyBits(mazeImage[0], mazeImage[6], mazeRect, mazeRect, srcCopy, nil);
        for i := 0 to 4 do
            if youSee.rows[i][0] then
                CopyBits(mazeImage[1], mazeImage[6], viewRects[i], viewRects[i], srcCopy, nil);
        if (youSee.rows[0][1]) then
            CopyBits(mazeImage[4], mazeImage[6], viewRects[0], viewRects[0], srcCopy, nil);
        if (youSee.rows[4][1]) then
            CopyBits(mazeImage[4], mazeImage[6], viewRects[4], viewRects[4], srcCopy, nil);
        if (youSee.rows[1][1]) then
            CopyBits(mazeImage[5], mazeImage[6], viewRects[12], viewRects[12], srcCopy, nil);
        if (youSee.rows[3][1]) then
            CopyBits(mazeImage[5], mazeImage[6], viewRects[13], viewRects[13], srcCopy, nil);
        for i := 1 to 3 do
            if (youSee.rows[i][1]) then
                CopyBits(mazeImage[2], mazeImage[6], viewRects[i + 4], viewRects[i + 4], srcCopy, nil);
        if (youSee.rows[1][2]) then
            begin
                CopyBits(mazeImage[3], mazeImage[6], viewRects[1 + 7], viewRects[1 + 7], srcCopy, nil);
                CopyBits(mazeImage[5], mazeImage[6], viewRects[11 + (1 - 1) div 2 * 3], viewRects[11 + (1 - 1) div 2 * 3], srcCopy, nil);
            end;
        if (youSee.rows[3][2]) then
            begin
                CopyBits(mazeImage[3], mazeImage[6], viewRects[3 + 7], viewRects[3 + 7], srcCopy, nil);
                CopyBits(mazeImage[5], mazeImage[6], viewRects[11 + (3 - 1) div 2 * 3], viewRects[11 + (3 - 1) div 2 * 3], srcCopy, nil);
            end;

        if (youSee.rows[2][2]) then
            CopyBits(mazeImage[3], mazeImage[6], viewRects[9], viewRects[9], srcCopy, nil);
        if (youSee.rows[1][3]) then
            CopyBits(mazeImage[5], mazeImage[6], viewRects[8], viewRects[8], srcCopy, nil);
        if (youSee.rows[3][3]) then
            CopyBits(mazeImage[5], mazeImage[6], viewRects[10], viewRects[10], srcCopy, nil);
        CopyBits(mazeImage[6], myWindow^.portBits, mazeRect, mazeRect, srcCopy, nil);
    end; {DrawMaze}


{• A 'for' loop that creates 14 rectangles at an index of viewRects.}
{• This is like "SetRect, OffsetRect, SetRect, OffsetRect" etc x 14.}
{• Why only 14?  Because of the two outer walls of the 16 x 16 maze.}

{• The coordinate values are indexed times two for left, then zero}
{• for top, then index times two for the bottom, and 185 for right.}

    procedure DoRects;
        var
            i: Integer;
    begin
        for i := 0 to 14 do
            begin
                SetRect(viewRects[i], rectValues^^[i * 2], 0, rectValues^^[i * 2 + 1], 185);
            end;
    end;


    procedure InitMyMenus;
        const
            Menu_1 = 1001;
            Menu_2 = 1002;
            Menu_3 = 1003;
        var
            tempMenu: MenuHandle;
    begin
        ClearMenuBar;

    {• Apple menu.}
        tempMenu := GetMenu(Menu_1);
        InsertMenu(tempMenu, 0);
        AppendResMenu(tempMenu, 'DRVR');
        AppleMenu := tempMenu;

    {• This menu is File.}
        tempMenu := GetMenu(Menu_2);
        InsertMenu(tempMenu, 0);

    {• This menu is Commands.}
        tempMenu := GetMenu(Menu_3);
        InsertMenu(tempMenu, 0);

        DrawMenuBar;
    end;


    procedure SetView;
        var
            theRows: array[0..5, 0..4] of Byte;
            mx, my, i, j: Integer;
    begin
        case (yourView.facing) of
            0:
                begin
                    for j := 0 to 1 do
                        for i := 0 to 4 do
                            begin
                                mx := yourView.x - 2 + i;
                                my := yourView.y - 3 + j;

                                if (mx < 0) or (mx > 15) or (my < 0) or (my > 15) then
                                    youSee.rows[i][j] := false
                                else
                                    youSee.rows[i][j] := maze^^[my][mx];
                            end;
                    for j := 2 to 3 do
                        for i := 1 to 3 do
                            begin
                                mx := yourView.x - 2 + i;
                                my := yourView.y - 3 + j;
                                if (mx < 0) or (mx > 15) or (my < 0) or (my > 15) then
                                    youSee.rows[i][j] := false
                                else
                                    youSee.rows[i][j] := maze^^[my][mx];
                            end;
                end;
            1:
                for i := 3 downto 0 do
                    begin
                        mx := yourView.x + i;
                        for j := 0 to 4 do
                            begin
                                my := yourView.y - 2 + j;
                                if (mx < 0) or (mx > 15) or (my < 0) or (my > 15) then
                                    youSee.rows[j][-i + 3] := false
                                else
                                    youSee.rows[j][-i + 3] := maze^^[my][mx];
                            end;
                    end;
            2:
                for j := 0 to 3 do
                    begin
                        my := yourView.y + 3 - j;
                        for i := 0 to 4 do
                            begin
                                mx := yourView.x - 2 + i;
                                if (mx < 0) or (mx > 15) or (my < 0) or (my > 15) then
                                    youSee.rows[4 - i][j] := false
                                else
                                    youSee.rows[4 - i][j] := maze^^[my][mx];
                            end;
                    end;
            3:
                for i := 0 to 3 do
                    begin
                        mx := yourView.x - 3 + i;
                        for j := 0 to 4 do
                            begin
                                my := yourView.y - 2 + j;
                                if (mx < 0) or (mx > 15) or (my < 0) or (my > 15) then
                                    youSee.rows[4 - j][i] := false
                                else
                                    youSee.rows[4 - j][i] := maze^^[my][mx];
                            end;
                    end;
        end;
    end; {SetView}


    procedure MoveForward;
    begin
        case yourView.facing of
            0:
                if (not maze^^[yourView.y - 1][yourView.x]) then
                    yourView.y := yourView.y - 1;
            1:
                if (not maze^^[yourView.y][yourView.x + 1]) then
                    yourView.x := yourView.x + 1;
            2:
                if (not maze^^[yourView.y + 1][yourView.x]) then
                    yourView.y := yourView.y + 1;
            3:
                if (not maze^^[yourView.y][yourView.x - 1]) then
                    yourView.x := yourView.x - 1;
        end; {case}
        SetView;
        DrawMaze;
    end; {MoveForward}

    procedure TurnLeft;
    begin
        yourView.facing := BAnd(yourView.facing - 1, 3);

        SetView;
        DrawMaze;
    end;

    procedure TurnRight;
    begin
        yourView.facing := BAnd(yourView.facing + 1, 3);

        SetView;
        DrawMaze;
    end;

    procedure TurnAround;
    begin
        yourView.facing := BAnd(yourView.facing + 2, 3);

        SetView;
        DrawMaze;
    end;


    procedure InitMaze;
        var
            i: Integer;
            thePic: PicHandle;
    begin
        gridBytes := 28;        {• One byte per rectangle.}

        DoRects;

        SetRect(mazeRect, 0, 0, 216, 185);

        thePic := GetPicture(134);
        DrawPicture(thePic, mazeRect);

        repeat        {• Do nothing until a mouseDown.}
        until Button;

    {• Then run this loop.  It gets all six pictures, makes a new}
    {• bitmap for each one, erases the mazeRect, draws and erases}
    {• each one until the sixth one is drawn, then exits the loop.}
        for i := 0 to 6 do
            begin
                if i <> 6 then        {• If there are less than 6, get them.}
                    thePic := GetPicture(128 + i);

        {• Make a new pointer to each one.}
                mazeImageAdd[i] := NewPtr(LongInt(28 * 185));

        {• If "no dice" crap out.}
                if mazeImageAdd[i] = nil then
                    ExitToShell;

        {• Say what the b.a. and r.b. are for each.}
                mazeImage[i].baseAddr := QDPtr(mazeImageAdd[i]);
                mazeImage[i].rowBytes := gridBytes;    {• Originally 28.}

        {• Set a rect. for each bit immage, the same sizes.}
                SetRect(mazeImage[i].bounds, 0, 0, 224, 185);

        {• Erase the mazeRect and draw the picture if it's not the}
        {• sixth one.}
                if (i <> 6) then
                    begin
                        EraseRect(mazeRect);
                        DrawPicture(thePic, mazeRect);
{$ifc UNDEFINED THINK_PASCAL}
                        CopyBits(qd.thePort^.portBits, mazeImage[i], mazeRect, mazeRect, srcCopy, nil);
{$elsec}
                        CopyBits(thePort^.portBits, mazeImage[i], mazeRect, mazeRect, srcCopy, nil);
{$endc}
                    end;
            end;
    {• Your starting view is x-one, y-fourteen, facing in the zero}
    {• direction (zero is one out of four clockwise, or toward top).}
    {• So, on the 'maze' table, above, you are at the lower-right}
    {• facing up.}
        yourView.x := 1;
        yourView.y := 14;
        yourView.facing := 0;

    {• Now you just set whatever view you're facing, }
    {• according to key hit values and a read by a switch!}
        SetView;
    end; {InitMaze}

    procedure HandleMenu (var doneFlag: Boolean; theMenu: Integer; theItem: Integer; var theInput: TEHandle);
        const
    {• List in the menu bar.}
            List_Apple = 1001;
            Item_About_Mazes = 1;
    {• List in the menu bar.}
            List_File = 1002;
            Item_Quit = 1;
    {• List in the menu bar.}
            List_Commands = 1003;
            Item_Forward = 1;
            Item_Turn_Left = 2;
            Item_Turn_Right = 3;
            Item_Turn_Around = 4;
        var
            SavePort: GrafPtr;
            DAName: Str255;
            DNA: Integer;
            BoolHolder: Boolean;
    begin
        case theMenu of
            List_Apple:
                case theItem of
                    Item_About_Mazes:
                        D_About;
                    otherwise
                        begin
                            GetPort(SavePort);
                            GetMenuItemText(AppleMenu, theItem, DAName);
                            DNA := OpenDeskAcc(DAName);
                            SetPort(SavePort);
                        end; {otherwise}
                end; {case theItem}

            List_File:
                case theItem of
                    Item_Quit:
                        doneFlag := TRUE;
                end;
            List_Commands:
                begin
                    BoolHolder := SystemEdit(theItem - 1);
                    if (BoolHolder = FALSE) then
                        begin
                            case (theItem) of
                                Item_Forward:
                                    MoveForward;
                                Item_Turn_Left:
                                    TurnLeft;
                                Item_Turn_Right:
                                    TurnRight;
                                Item_Turn_Around:
                                    TurnAround;
                            end; {case theItem}
                        end;
                end; {List_Commands}
        end; {case theMenu}
        HiliteMenu(0);
    end; {HandleMenu}


{• Initialize us so all our routines can be activated.}
    procedure Init_P_D_Maze;
    begin
        myWindow := nil;
        rectValues := RectArrHnd(GetResource('RctV', 128));
        maze := MazeArrHnd(GetResource('Maze', 128));
    end;

{• Close our window.}
    procedure Close_P_D_Maze (whichWindow: WindowPtr; var theInput: TEHandle);
    begin
        if ((myWindow <> nil) and ((myWindow = whichWindow) or (whichWindow = WindowPtr(-1)))) then
            begin
                DisposeWindow(myWindow);
                myWindow := nil;
            end;
    end;

{• Update our window, someone uncovered a part of us.}
    procedure UpDate_P_D_Maze (whichWindow: WindowPtr);
        var
            SavePort: WindowPtr;
    begin
        if ((myWindow <> nil) and (myWindow = whichWindow)) then
            begin
                GetPort(SavePort);
                SetPort(myWindow);
                DrawControls(myWindow);
                DrawMaze;
                SetPort(SavePort);
            end;
    end;

{• Open our window and draw everything.}
    procedure Open_P_D_Maze (var theInput: TEHandle);
        var
            index: Integer;
            dataBounds: Rect;
            cSize: Point;
    begin
        if (myWindow = nil) then
            begin
                myWindow := GetNewWindow(1, nil, WindowPtr(-1));
                SetPort(myWindow);

                ShowWindow(myWindow);
                SelectWindow(myWindow);
                InitMaze;
                DrawMaze;
            end
        else
            SelectWindow(myWindow);
        DrawMaze;
    end;

{• Handle action to our window, like controls.}
    procedure Do_P_D_Maze (var myEvent: EventRecord; var theInput: TEHandle);
        var
            RefCon: Integer;
            code: Integer;
            theValue: Integer;
            whichWindow: WindowPtr;
            myPt: Point;
            theControl: ControlHandle;

    begin    {• Start of Window handler.}
        if myWindow <> nil then
            begin
                code := FindWindow(myEvent.where, whichWindow);
                if ((myEvent.what = mouseDown) and (myWindow = whichWindow)) then
                    begin
                        myPt := myEvent.where;
                        GlobalToLocal(myPt);
                    end;
                if ((myWindow = whichWindow) and (code = inContent)) then
                    begin
                        code := FindControl(myPt, whichWindow, theControl);
                        if (code <> 0) then
                            code := TrackControl(theControl, myPt, nil);
                    end;
            end;
    end; {Do_P_D_Maze}

    var
        doneFlag: Boolean;
        Is_A_Dialog: char;
        stillInGoAway: Boolean;
        ch: char;
        code: Integer;
        theMenu, theItem: Integer;
        chCode: Integer;
        mResult: LongInt;
        whichWindow: WindowPtr;
        myEvent: EventRecord;
        theInput: TEHandle;
        OldRect: Rect;
        SavePort: GrafPtr;

begin {Main program}
{$IFC UNDEFINED THINK_PASCAL}
    InitGraf(@qd.thePort);
    InitFonts;
    FlushEvents(everyEvent, 0);
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);
    InitCursor;
{$ENDC}

{$ifc UNDEFINED THINK_PASCAL}
    gScreenBitsBounds := qd.screenBits.bounds;
{$elsec}
    gScreenBitsBounds := screenBits.bounds;
{$endc}

    doneFlag := FALSE;

    InitMyMenus;
    theInput := nil;
    Init_P_D_Maze;
    Open_P_D_Maze(theInput);

    repeat
        if (theInput <> nil) then
            TEIdle(theInput);

        SystemTask;
        if (GetNextEvent(everyEvent, myEvent)) then
            begin
                code := FindWindow(myEvent.where, whichWindow);
                case myEvent.what of
                    mouseDown:
                        if (code = inMenuBar) then
                            begin
                                mResult := MenuSelect(myEvent.where);
                                theMenu := HiWord(mResult);
                                theItem := LoWord(mResult);
                                HandleMenu(doneFlag, theMenu, theItem, theInput);
                            end
                        else if ((code = inDrag) and (whichWindow <> nil)) then
                            begin
                                tempRect := gScreenBitsBounds;
                                SetRect(tempRect, tempRect.left + 10, tempRect.top + 25, tempRect.right - 10, tempRect.bottom - 10);
                                DragWindow(whichWindow, myEvent.where, tempRect);
                            end
                        else if (code = inGrow) then
                            begin
                                SetPort(whichWindow);

                                myPt := myEvent.where;
                                GlobalToLocal(myPt);

                                OldRect.left := whichWindow^.portRect.left;
                                OldRect.right := whichWindow^.portRect.right;
                                OldRect.top := whichWindow^.portRect.top;
                                OldRect.bottom := whichWindow^.portRect.bottom;

                                SetRect(tempRect, 15, 15, (gScreenBitsBounds.right - gScreenBitsBounds.left), (gScreenBitsBounds.bottom - gScreenBitsBounds.top) - 20);
                                mResult := GrowWindow(whichWindow, myEvent.where, tempRect);
                                SizeWindow(whichWindow, LoWord(mResult), HiWord(mResult), TRUE);

                                SetPort(whichWindow);

                                SetRect(tempRect, 0, myPt.v - 15, myPt.h + 15, myPt.v + 15);
                                EraseRect(tempRect);
                                InvalRect(tempRect);
                                SetRect(tempRect, myPt.h - 15, 0, myPt.h + 15, myPt.v + 15);
                                EraseRect(tempRect);
                                InvalRect(tempRect);
                                DrawGrowIcon(whichWindow);
                            end
                        else if (code = inGoAway) then
                            begin
                                stillInGoAway := TrackGoAway(whichWindow, myEvent.where);
                                if (stillInGoAway = TRUE) then

                                    case GetWRefCon(whichWindow) of
                                        1:
                                            Close_P_D_Maze(whichWindow, theInput);
                                    end; {case}
                            end
                        else if (code = inContent) then
                            if whichWindow <> FrontWindow then
                                SelectWindow(whichWindow)
                            else
                                begin
                                    SetPort(whichWindow);
                                    case (GetWRefCon(whichWindow)) of
                                        1:
                                            Do_P_D_Maze(myEvent, theInput);
                                    end;
                                end
                        else if (code = inSysWindow) then
                            begin
                                SystemClick(myEvent, whichWindow);
                            end
                        else if ((code = inZoomIn) or (code = inZoomOut)) then
                            if whichWindow <> nil then
                                begin
                                    SetPort(whichWindow);

                                    myPt := myEvent.where;
                                    GlobalToLocal(myPt);

                                    if (TrackBox(whichWindow, myPt, code) = TRUE) then
                                        begin
                                            ZoomWindow(whichWindow, code, TRUE);
                                            SetRect(tempRect, 0, 0, 32000, 32000);
                                            EraseRect(tempRect);
                                            InvalRect(tempRect);
                                        end;
                                end;

                    keyDown, autoKey:
                        begin
                            ch := Char(BAnd(myEvent.message, charCodeMask));
                            mResult := MenuKey(ch);
                            theMenu := HiWord(mResult);
                            theItem := LoWord(mResult);
                            if (theMenu <> 0) then
                                HandleMenu(doneFlag, theMenu, theItem, theInput);
                        end;

                    updateEvt:
                        begin
                            whichWindow := WindowPtr(myEvent.message);
                            GetPort(SavePort);
                            BeginUpdate(whichWindow);
                            SetPort(whichWindow);
                            case (GetWRefCon(whichWindow)) of
                                1:
                                    UpDate_P_D_Maze(whichWindow);
                            end;
                            EndUpdate(whichWindow);
                            SetPort(SavePort);
                        end;

                    diskEvt:
                        if (HiWord(myEvent.message) <> 0) then
                            begin
                                myEvent.where.h := ((gScreenBitsBounds.right - gScreenBitsBounds.left) div 2) - (304 div 2);
                                myEvent.where.v := ((gScreenBitsBounds.bottom - gScreenBitsBounds.top) div 3) - (104 div 2);
                                InitCursor;
                                theItem := DIBadMount(myEvent.where, myEvent.message);
                            end;

                    {app1Evt}
                    12:
                        if (HiWord(myEvent.message) = 1) and (LoWord(myEvent.message) = 1) then
                            Open_P_D_Maze(theInput)
                        else if (HiWord(myEvent.message) = 2) and (LoWord(myEvent.message) = 1) then
                            Close_P_D_Maze(WindowPtr(-1), theInput);
                    activateEvt:
                        if (whichWindow <> nil) and (BAnd(myEvent.modifiers, activeFlag) <> 0) then
                            begin
                                SelectWindow(whichWindow);
                            end;
                end;
            end;
    until doneFlag;
end.